home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD70856242000.psc / Class Version / CDrag_Drop.cls next >
Encoding:
Visual Basic class definition  |  2000-06-18  |  3.3 KB  |  125 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "CDrag_Drop"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  15.  
  16. '       THE DRAG CLASS
  17. '       ~~~~~~~~~~~~~~
  18.  
  19. 'You can use this class in any of your projects, in anyform
  20. 'you like, modify it according to your needs, but give credit
  21. 'where credit is due.
  22. '                               -Author:    Muhammad Abubakar
  23. '                                       <joehacker@yahoo.com>
  24. '                                       http://go.to/abubakar
  25.  
  26. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  27.  
  28. Option Explicit
  29.  
  30. Public Event FilesDroped()
  31. Private m_DragHwnd As Long
  32. Private m_FileCount As Integer
  33. Private FileNames() As String
  34. Private Working As Boolean
  35. Private Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal Hwnd As Long, ByVal fAccept As Long)
  36.  
  37. Friend Sub AddInFileNames(Buffer As String)
  38.     ReDim Preserve FileNames(0 To m_FileCount)
  39.     FileNames(m_FileCount) = Buffer
  40.     m_FileCount = m_FileCount + 1
  41.     'Debug.Print "file recieved : " & Buffer
  42.     
  43. End Sub
  44.  
  45. Friend Sub NowRaiseEvent()
  46.     RaiseEvent FilesDroped
  47. End Sub
  48.  
  49. Friend Sub ClearFileNames()
  50.     ReDim FileNames(0)
  51.     m_FileCount = 0
  52.  
  53. End Sub
  54. Public Function StartDrag() As Long
  55.     'This will start monitoring for the message of WM_DROPFILES
  56.     'If already working then we wont subclass again
  57.     If Working = False Then
  58.         If m_DragHwnd > 0 Then
  59.             DragAcceptFiles m_DragHwnd, True
  60.             'Set obj = Me
  61.             
  62.             PrevWndFunc = SetWindowLong(m_DragHwnd, GWL_WNDPROC, AddressOf WndProc)
  63.             StartDrag = 1 'Successfully started
  64.             Working = True
  65.             
  66.         Else
  67.             StartDrag = 0 'Unsuccessful, handle not given
  68.             
  69.         End If
  70.     Else
  71.         StartDrag = 2
  72.     End If
  73.     
  74. End Function
  75. Public Property Get DragHwnd() As Long
  76.     m_DragHwnd = DragHwnd
  77.  
  78. End Property
  79.  
  80. Public Property Let DragHwnd(ByVal Hwnd As Long)
  81.     
  82.     If Not Working Then m_DragHwnd = Hwnd
  83.     
  84. End Property
  85. Public Function StopDrag() As Long
  86.     'Stop subclassing and monitoring of WM_DROPFILES message.
  87.     
  88.     If Working = True Then
  89.         SetWindowLong m_DragHwnd, GWL_WNDPROC, PrevWndFunc
  90.         DragAcceptFiles m_DragHwnd, False
  91.         Working = False
  92.         StopDrag = 1 'successfully stoped subclassing
  93.         
  94.     Else
  95.         StopDrag = 0 'It was already not subclassed so no need to unsubclass
  96.         
  97.     End If
  98. End Function
  99. Public Function FileName(index As Integer) As String
  100.     If index >= 0 And index <= m_FileCount Then
  101.         FileName = FileNames(index)
  102.     Else
  103.         FileName = ""
  104.     End If
  105.     
  106. End Function
  107.  
  108. Private Sub Class_Initialize()
  109.     m_DragHwnd = 0
  110.     m_FileCount = 0
  111.     'obj is declared in BAS- <CDrag_Drop_Module> of type CDrag_Drop
  112.     Set obj = Me
  113.     
  114. End Sub
  115.  
  116. Private Sub Class_Terminate()
  117.     If Working = True Then StopDrag
  118.     
  119. End Sub
  120.  
  121. Public Property Get FileCount() As Integer
  122.     FileCount = m_FileCount
  123.     
  124. End Property
  125.